home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / cw_form.pro < prev    next >
Text File  |  1997-07-08  |  19KB  |  542 lines
  1. ; $Id: cw_form.pro,v 1.10 1997/01/15 03:11:50 ali Exp $
  2. ;
  3. ; Copyright (c) 1995-1997, Research Systems, Inc.  All rights reserved.
  4. ;    Unauthorized reproduction prohibited.
  5. ;+
  6. ; NAME:
  7. ;    CW_FORM
  8. ;
  9. ; PURPOSE:
  10. ;    CW_FORM is a compound widget that simplifies creating
  11. ;    small forms which contain text, numeric fields, buttons, 
  12. ;    lists and droplists.  Event handling is also simplified.
  13. ;
  14. ; CATEGORY:
  15. ;    Compound widgets.
  16. ;
  17. ; CALLING SEQUENCE:
  18. ;    widget = CW_FORM([Parent,] Desc)
  19. ;
  20. ; INPUTS:
  21. ;       Parent:    The ID of the parent widget.  Omitted for a top level 
  22. ;        modal widget.
  23.  
  24. ; Desc: A string array describing the form.  Each element of the
  25. ;    string array contains two or more comma-delimited fields.  The
  26. ;    character '\' may be used to escape commas that appear within fields.
  27. ;    To include the backslash character, escape it with a second
  28. ;    backslash.  Field names are case insensitive.
  29. ;
  30. ;    The fields are defined as follows:
  31. ;
  32. ; Field 1: Depth: the digit 0, 1, 2, or 3.  0 continues the current
  33. ;    level, 1 begins a new level, 2 denotes the last element of the
  34. ;    current level, and 3 both begins a new level and is the last entry of
  35. ;    the current level.  Nesting is used primarily with row or column 
  36. ;    bases for layout.  See the example below.
  37. ; Field 2: Item type: BASE, BUTTON, DROPLIST, FLOAT, INTEGER, LABEL, LIST,
  38. ;        or TEXT.
  39. ;    The items return the following value types:
  40. ;    BUTTON - For single buttons, 0 if clear, 1 if set.
  41. ;        For multiple buttons, also called button groups, that are
  42. ;        exclusive, the index of the currently set button is returned.
  43. ;        For non-exclusive button groups, the value is an array
  44. ;        with an element for each button, containing 1
  45. ;        if the button is set, 0 otherwise.
  46. ;    DROPLIST, LIST - a 0 based index indicating which item is selected.
  47. ;    FLOAT, INTEGER, TEXT - return their respective data type.
  48. ;
  49. ; Field 3: Initial value.  Omitted for bases.
  50. ;    For BUTTON and DROPLIST items, the value field contains one
  51. ;        or more item names, delimited by the | character.
  52. ;    For FLOAT, INTEGER, LABEL, and TEXT items the value field contains the
  53. ;        initial value of the field.
  54. ;
  55. ; Fields 4 and following: Keywords or Keyword=value pairs that specify
  56. ;    optional attributes or options.  Keywords are case insensitive
  57. ;    and an optional leading '/' character is discarded.
  58. ;    Possibilities include:
  59. ;
  60. ;    COLUMN    If present, specifies column layout for bases or multiple
  61. ;        buttons.
  62. ;    EXCLUSIVE  If present makes an exclusive set of buttons.  The
  63. ;        default is nonexclusive.
  64. ;    EVENT=<name> specifies the name of a user-written event function that
  65. ;        is called whenever the element is changed.  The function
  66. ;        is called with one parameter, the event structure.  It may
  67. ;        return an event structure or zero to indicate that no
  68. ;        further event processing is desired.
  69. ;    FONT=<font name>  If present, the font for the item is specified.
  70. ;    FRAME:    If present, a frame is drawn around the item.  May be used
  71. ;        with all items.
  72. ;    LABEL_LEFT=<label>  annotate a button or button group with a label
  73. ;        placed to the left of the buttons.  Valid with BUTTON,
  74. ;        DROPLIST, FLOAT, INTEGER, LIST and TEXT items.
  75. ;    LABEL_TOP=<label> annotate a button or button group with a label
  76. ;        placed at the top of the buttons.  Valid with BUTTON,
  77. ;        DROPLIST, FLOAT, INTEGER, LIST and TEXT items.
  78. ;    LEFT, CENTER, or RIGHT   Specifies alignment of label items.
  79. ;    QUIT    If present, when the user activiates this entry when it
  80. ;        is activated as a modal widget, the form is destroyed
  81. ;        and its value returned as the result of CW_FORM.  For non-
  82. ;        modal form widgets, events generated by changing this item
  83. ;        have their QUIT field set to 1.
  84. ;    ROW    If present, specifies row layout for bases or multiple
  85. ;        buttons.
  86. ;    SET_VALUE  Sets the initial value of button groups or droplists.
  87. ;    TAG=<name>   the tag name  of this element.  The widget's value
  88. ;        is a structure corresponding to the form.  Each form item
  89. ;        has a corresponding tag-value pair in the widget's value.
  90. ;        Default = TAGnnn, where nnn is the index of the item
  91. ;        in the Desc array.
  92. ;    WIDTH=n Specifies the width, in characters, of a TEXT, INTEGER,
  93. ;        or FLOAT item.
  94. ;    
  95. ; KEYWORD PARAMETERS:
  96. ;    COLUMN:          If set the main orientation is vertical, otherwise
  97. ;              horizontal.
  98. ;    IDS:          A named variable into which the widget id of
  99. ;                each widget corresponding to an element
  100. ;                in desc is stored.
  101. ;    TITLE:          The title of the top level base.  Not used
  102. ;              if a parent widget is supplied.
  103. ;    UVALUE:          The user value to be associated with the widget.
  104. ;
  105. ; OUTPUTS:
  106. ;       If Parent is supplied, the result is the ID of the base containing
  107. ;    the form.  If Parent is omitted, the form is realized as a modal
  108. ;    top level widget. The function result is then a structure containing
  109. ;    the value of each field in the form when the user finishes.
  110. ;
  111. ;    This widget has a value that is a structure with a tag/value pair
  112. ;    for each field in the form.  WIDGET_CONTROL, id, GET_VALUE=v may
  113. ;    be used to read the current value of the form.  WIDGET_CONTROL, id,
  114. ;    SET_VALUE={ Tagname: value, ..., Tagname: value} sets the values
  115. ;    of one or more tags.
  116. ;
  117. ; SIDE EFFECTS:
  118. ;    Widgets are created.
  119. ;
  120. ; RESTRICTIONS:
  121. ;    
  122. ; EXAMPLES:
  123.  
  124. ;    **** Define a form, with a label, followed by two vertical button
  125. ;    groups one non-exclusive and the other exclusive, followed by a text
  126. ;    field, and an integer field, followed lastly by OK and Done buttons.
  127. ;    If either the OK or Done buttons are pressed, the form is exited.
  128. ;    
  129. ;
  130. ;        ; String array describing the form
  131. ;    desc = [ $
  132. ;        '0, LABEL, Centered Label, CENTER', $
  133. ;        ; Define a row base on a new depth.  All elements until a depth
  134. ;        ; of two are included in the row.
  135. ;         '1, BASE,, ROW, FRAME', $
  136. ;         '0, BUTTON, B1|B2|B3, LABEL_TOP=Nonexclusive:, COLUMN, TAG=bg1', $
  137. ;        ; This element terminates the row.
  138. ;         '2, BUTTON, E1|E2|E2, EXCLUSIVE,LABEL_TOP=Exclusive,COLUMN,TAG=bg2', $
  139. ;         '0, TEXT, , LABEL_LEFT=Enter File name:, WIDTH=12, TAG=fname', $
  140. ;        '0, INTEGER, 0, LABEL_LEFT=File size:, WIDTH=6, TAG=fsize', $
  141. ;        '1, BASE,, ROW', $
  142. ;        '0, BUTTON, OK, QUIT,FONT=*helvetica-medium-r-*-180-*,TAG=OK', $
  143. ;        '2, BUTTON, Cancel, QUIT']
  144. ;
  145. ;    To use the form in a modal manner:
  146. ;      a = CW_FORM(desc, /COLUMN)
  147. ;      help, /st,a
  148. ;    When the form is exited, (when the user presses the OK or Cancel buttons), 
  149. ;    the following structure is returned as the function's value:
  150. ;        BG1             INT       Array(3)  (Set buttons = 1, else 0)
  151. ;        BG2             INT              1  (Exclusive: a single index)
  152. ;        FNAME           STRING    'test.dat' (text field)
  153. ;        FSIZE           LONG               120 (integer field)
  154. ;        OK              LONG                 1 (this button was pressed)
  155. ;        TAG8            LONG                 0 (this button wasn't)
  156. ;    Note that if the Cancel button is pressed, the widget is exited with
  157. ;    the OK field set to 0.
  158. ;
  159. ;  *****************
  160. ;
  161. ;    To use CW_FORM inside another widget:
  162. ;        a = widget_base(title='Testing')
  163. ;        b = cw_form(a, desc, /COLUMN)
  164. ;        WIDGET_CONTROL, a, /real
  165. ;        xmanager, 'Test', a
  166. ;    In this example, an event is generated each time the value of
  167. ;    the form is changed.  The event has the following structure:
  168. ;       ID              LONG                <id of CW_FORM widget>
  169. ;       TOP             LONG                <id of top-level widget>
  170. ;       HANDLER         LONG                <internal use>
  171. ;       TAG             STRING    'xxx'    ; name of field that changed
  172. ;       VALUE           INT       xxx    ; new value of changed field
  173. ;       QUIT            INT              0    ; quit flag
  174. ;    The event handling procedure (in this example, called TEST_EVENT), may use
  175. ;    the TAG field of the event structure to determine which field
  176. ;    changed and perform any data validation or special actions required.
  177. ;    It can also get and set the value of the widget by calling
  178. ;    WIDGET_CONTROL.
  179. ;    A simple event procedure might be written to monitor the QUIT field
  180. ;    of events from the forms widget, and if set, read and save the
  181. ;    widget's value, and finally destroy the widget.
  182. ;
  183. ;    To set or change a field within the form from a program, use a the
  184. ;    WIDGET_CONTROL procedure:
  185. ;           WIDGET_CONTROL, b, SET_VALUE={FNAME: 'junk.dat'}
  186. ;    This statement sets the file name field of this example.
  187. ;
  188. ; MODIFICATION HISTORY:
  189. ;    January, 1995.  DMS, Written.
  190. ;       June, 1996.     MLR, allowed SET_VALUE to be specified in the
  191. ;                       description string for DROPLIST widgets.
  192. ;-
  193. ;
  194.  
  195.  
  196. function CW_FORM_PARSE, Extra, Name, Value, Index=Index
  197. ; Given the extra fields in the string array Extra,
  198. ;    determine if one field starts with Name.
  199. ; If so, return TRUE, otherwise FALSE.
  200. ; If the field contains the character '=' after Name, return the contents
  201. ; of the field following the equal sign in Value.
  202. ; Return the index of the found element in Index.
  203. ;
  204.  
  205. found = where(strpos(extra, name) eq 0, count)
  206. if count eq 0 then return, 0
  207. if count gt 1 then message,'Ambiguous field name: '+name, /CONTINUE
  208.  
  209. index = found[0]
  210. item = extra[index]
  211. nlen = strlen(name)
  212. value = ''            ;Assume no value
  213. equal = strpos(item,'=',nlen) ;Find = character
  214. if equal ge 0 then value = strmid(item, equal+1, 1000) ;Extract following
  215. extra[index]=''            ;clean it out...
  216. return, 1
  217. end
  218.  
  219.  
  220. pro CW_FORM_APPEND, extra, e, keyword, USE_VALUE=use_value, ACTUAL_KEYWORD=akw
  221. if CW_FORM_PARSE(e, keyword, value) then begin
  222.     if n_elements(akw) le 0 then akw = keyword
  223.     if KEYWORD_SET(use_value) eq 0 then value = 1
  224.     if n_elements(extra) eq 0 then extra = create_struct(akw, value) $
  225.     else extra = create_struct(extra, akw, value)
  226. endif
  227. end
  228.  
  229.  
  230.  
  231. pro CW_FORM_LABEL, parent, nparent, e, frame
  232. ;Put LABEL_LEFT and/or LABEL_RIGHT on a base.
  233.  
  234. nparent = parent
  235. if CW_FORM_PARSE(e, 'LABEL_LEFT', value) then begin
  236.     nparent = WIDGET_BASE(nparent, /ROW, FRAME=frame)
  237.     frame = 0
  238.     junk1 = WIDGET_LABEL(nparent, VALUE=value)
  239.     endif
  240. if CW_FORM_PARSE(e, 'LABEL_TOP', value) then begin
  241.     nparent = WIDGET_BASE(nparent, /COLUMN, FRAME=frame)
  242.     frame = 0
  243.     junk1 = WIDGET_LABEL(nparent, VALUE=value)
  244.     endif
  245. end
  246.  
  247.  
  248.  
  249. pro CW_FORM_BUILD, parent, desc, cur, ids, lasttag
  250. ; Recursive routine that builds the form hierarchy described in DESC.
  251. ; Returns the ID of each button in ids.
  252.  
  253. ; Format of a field descriptor:
  254. ; Field 0,  Flags: 
  255. ; Field 1, Type of item.  BASE, LABEL, INTEGER, FLOAT, DROPLIST,
  256. ;    EXCLUSIVE_BUTTONS, TEXT
  257. ; Field 2, Value of item...
  258. ; Fields >= 3, optional flags
  259. ;
  260. ;
  261. ; Type id = 0 for bgroup, 1 for droplist, 2 for button,
  262. ;    3 for integer, 4 for float, 5 for text, 6 for list.
  263. ;
  264.   n = n_elements(desc)
  265.  
  266.   while cur lt n do begin
  267.     a = str_sep(desc[cur], ',', /TRIM, ESC='\')
  268.     if n_elements(a) lt 2 then $
  269.     message,'Form element '+strtrim(cur,2)+'is missing a field separator'
  270.     extra=0            ;Clear extra keywords by making it undefined
  271.     junk = temporary(extra)    ;Clear common param list
  272.     type = -1            ;Assume type == no events.
  273.     quit = 0
  274.     frame = 0
  275.     if n_elements(a) gt 3 then begin    ;Addt'l common params?
  276.     e = a[3:*]        ;Remove leading/trailing blanks
  277.     for i=0, n_elements(e)-1 do begin  ;Up case it
  278.         s = e[i]
  279.         if strmid(s,0,1) eq '/' then s = strmid(s,1,1000)  ;Disc. leading /
  280.         equal = strpos(s, '=')
  281.         if equal gt 0 then $
  282.         e[i] = strupcase(strmid(s,0,equal)) + strmid(s,equal, 1000) $
  283.         else e[i] = strupcase(s)
  284.         endfor 
  285.     quit = CW_FORM_PARSE(e, 'QUIT')
  286.     frame = CW_FORM_PARSE(e, 'FRAME')
  287.     efn = CW_FORM_PARSE(e, 'EVENT', event_fun)
  288.     CW_FORM_APPEND, extra, e, 'FONT', /USE_VALUE
  289.     CW_FORM_APPEND, extra, e, 'COLUMN'
  290.     CW_FORM_APPEND, extra, e, 'ROW'
  291.     CW_FORM_APPEND, extra, e, 'LEFT', ACTUAL='ALIGN_LEFT'
  292.     CW_FORM_APPEND, extra, e, 'CENTER', ACTUAL='ALIGN_CENTER'
  293.     CW_FORM_APPEND, extra, e, 'RIGHT', ACTUAL='ALIGN_RIGHT'
  294.     endif else e = ''
  295.  
  296.     case STRUPCASE(a[1]) of        ;Which widget type?
  297. 'BASE': BEGIN
  298.     new = WIDGET_BASE(parent, FRAME=frame, _EXTRA=extra)
  299.     ENDCASE
  300. 'BUTTON': BEGIN
  301.     CW_FORM_APPEND, extra, e, 'LABEL_LEFT', /USE_VALUE
  302.     CW_FORM_APPEND, extra, e, 'LABEL_TOP', /USE_VALUE
  303.     CW_FORM_APPEND, extra, e, 'SET_VALUE', /USE_VALUE
  304.     exclusive = CW_FORM_PARSE(e,'EXCLUSIVE')
  305.     no_release = CW_FORM_PARSE(e,'NO_RELEASE')
  306.     values = str_sep(a[2],'|', ESC='\')
  307.     if n_elements(values) ge 2 then begin
  308.         type = 0
  309.         new = CW_BGROUP(parent, str_sep(a[2],'|'),  $
  310.                 EXCLUSIVE = exclusive, NONEXCLUSIVE = 1-exclusive, $
  311.                 FRAME=frame, NO_RELEASE = no_release, _EXTRA=extra)
  312.         WIDGET_CONTROL, new, GET_VALUE=value
  313.     endif else begin
  314.         type = 2
  315.     new = WIDGET_BUTTON(parent, value=values[0], FRAME=frame, _EXTRA=extra)
  316.     value = 0L
  317.     endelse
  318.     uextra = { value: value }
  319.     ENDCASE
  320. 'DROPLIST': BEGIN
  321.     CW_FORM_LABEL, parent, nparent, e, frame
  322.     new = WIDGET_DROPLIST(nparent, VALUE = str_sep(a[2], '|'), $
  323.         FRAME=frame, UVALUE=ids[n], _EXTRA=extra)
  324.     if CW_FORM_PARSE(e, 'SET_VALUE', value) then $
  325.           WIDGET_CONTROL, new, SET_DROPLIST_SELECT = value
  326.     uextra = { VALUE: 0L }
  327.     type = 1
  328.     ENDCASE
  329. 'INTEGER': BEGIN
  330.     type = 3
  331.     value = 0L
  332. process_integer:
  333.     uextra = { VALUE: value }    
  334.     CW_FORM_LABEL, parent, nparent, e, frame
  335.     if CW_FORM_PARSE(e, 'WIDTH', temp) then width = fix(temp) else width=6
  336.     new = WIDGET_TEXT(nparent, /ALL_EVENTS, /EDITABLE, YSIZE=1, $
  337.         XSIZE=width, UVALUE=ids[n])
  338.     if n_elements(a) ge 3 then BEGIN        ;Save value
  339.     WIDGET_CONTROL, new, SET_VALUE=a[2]
  340.     uextra.value = a[2]
  341.     endif
  342.    ENDCASE
  343. 'FLOAT': BEGIN
  344.     type = 4
  345.     value = 0.0
  346.     goto, process_integer
  347.     ENDCASE
  348. 'LABEL': BEGIN
  349.     new = WIDGET_LABEL(parent, value=a[2], FRAME=frame, _EXTRA=extra)
  350.     ENDCASE
  351. 'LIST': BEGIN
  352.     CW_FORM_LABEL, parent, nparent, e, frame
  353.     v = str_sep(a[2], '|')
  354.     if CW_FORM_PARSE(e, 'HEIGHT', temp) eq 0 then temp = n_elements(v)
  355.     new = WIDGET_LIST(nparent, VALUE = v, YSIZE=temp, $
  356.         FRAME=frame, UVALUE=ids[n], _EXTRA=extra)
  357.     v = 0
  358.     uextra = { VALUE: 0L }
  359.     type = 6
  360.     ENDCASE
  361. 'TEXT': BEGIN
  362.     type=5
  363.     value = ''
  364.     goto, process_integer
  365.     ENDCASE
  366. else: BEGIN
  367.     MESSAGE,'Illegal form element type: ' + a[1], /CONTINUE
  368.     new = WIDGET_BASE(parent)
  369.     ENDCASE
  370. ENDCASE
  371.  
  372.     ids[cur] = new
  373.     if type ge 0 then begin
  374.     if CW_FORM_PARSE(e, 'TAG', value) then value = STRUPCASE(value) $
  375.     else value='TAG'+strtrim(cur,2)      ;default name = TAGnnn.
  376.         u = CREATE_STRUCT( $
  377.         { type: type, base: ids[n+1], tag:value, next: 0L, quit:quit}, $
  378.         uextra)
  379.     widget_control, new, SET_UVALUE= u
  380.         ;First tag?  If so, set child uvalue -> important widget ids.
  381.     if lasttag eq 0 then begin
  382.         WIDGET_CONTROL, ids[n], GET_UVALUE=tmp, /NO_COPY
  383.         tmp.head = new
  384.         WIDGET_CONTROL, ids[n], SET_UVALUE=tmp, /NO_COPY
  385.     endif else begin        ;Otherwise, update chain.
  386.         WIDGET_CONTROL, lasttag, GET_UVALUE=u, /NO_COPY
  387.         u.next = new
  388.         WIDGET_CONTROL, lasttag, SET_UVALUE=u, /NO_COPY
  389.         endelse
  390.     lasttag = new
  391.     if (N_ELEMENTS(efn) NE 0) AND (N_ELEMENTS(event_fun) NE 0) then $
  392.            WIDGET_CONTROL, new, EVENT_FUNC = event_fun
  393.     endif            ;Type
  394.  
  395.     i = where(strlen(e) gt 0, count)
  396.     if count gt 0 then begin    ;Unrecognized fields?
  397.     Message, /CONTINUE, 'Descriptor: '+ desc[cur]
  398.     for j=0, count-1 do message, /CONTINUE, 'Unrecognized field: '+ e[i[j]]
  399.     endif
  400.  
  401.     cur = cur + 1
  402.     dflags = fix(a[0])        ;Level flags
  403.     if dflags and 1 then CW_FORM_BUILD, new, desc, cur, ids, lasttag  ;Begin new
  404.     if (dflags and 2) ne 0 then return    ;End current
  405.   endwhile
  406. end                ;CW_FORM_BUILD
  407.  
  408.  
  409.  
  410. Function CW_FORM_EVENT, ev        ;Event handler for CW_FORM
  411. widget_control,   ev.id, GET_UVALUE=u, /NO_COPY  ;What kind of widget?
  412.  
  413. if (u.type eq 1) or (u.type eq 6) then begin    ;Droplist?  (can't get value)
  414.     v = ev.index
  415.     u.value = v
  416. endif else if u.type eq 2 then begin
  417.     v = ev.select
  418.     u.value=v
  419. endif else begin        ;Other types of widgets
  420.     WIDGET_CONTROL, ev.id, GET_VALUE=v
  421.     if u.type ge 3 then begin  ;Toss selection events from text widgets
  422.     v = v[0]
  423.         ret = 0
  424.     if ev.type eq 3 then goto, toss
  425.     endif
  426.     on_ioerror, invalid
  427.     u.value = v            ;Does an implicit conversion
  428.     v = u.value
  429.     goto, back_in
  430.  
  431. ; We come here if we get an invalid number.  
  432. invalid: WIDGET_CONTROL, ev.id, SET_VALUE=''  ;Blank it out
  433.     v = ''
  434.     u.value = ''
  435. endelse            ;u.type
  436.  
  437. back_in: ret= { id: u.base, top: ev.top, handler: 0L, $
  438.         tag: u.tag, value: v, quit: u.quit} ;Our value
  439. toss: widget_control, ev.id, SET_UVALUE=u, /NO_COPY    ;Save new value...
  440. return, ret
  441. end            ;CW_FORM_EVENT
  442.  
  443.  
  444. Pro CW_FORM_SETV, id, value    ;In this case, value = { Tagname : value, ... }
  445. x = WIDGET_INFO(id, /CHILD)    ;Get head of list
  446. WIDGET_CONTROL, x, GET_UVALUE=u
  447. head = u.head
  448. tags = tag_names(value)
  449. n = n_elements(tags)
  450.  
  451. while head ne 0 do begin
  452.     WIDGET_CONTROL, head, GET_UVALUE=u, /NO_COPY
  453.     w = where(u.tag eq tags, count)
  454.     if count ne 0 then begin
  455.     u.value = value.(w[0])    ;Set the value
  456.     if u.type eq 6 then $
  457.           WIDGET_CONTROL, head, SET_LIST_SELECT=value.(w[0]) $
  458.         else if u.type eq 1 then $
  459.           WIDGET_CONTROL, head, SET_DROPLIST_SELECT = value.(w[0]) $
  460.     else if u.type ne 2 then $
  461.           WIDGET_CONTROL, head, SET_VALUE=value.(w[0]) ;Change the widget
  462.     n = n - 1
  463.     endif
  464.     next = u.next
  465.     WIDGET_CONTROL, head, SET_UVALUE=u, /NO_COPY
  466.     if n le 0 then return        ;Done...
  467.     head = next
  468. endwhile
  469. end
  470.  
  471.  
  472. Function CW_FORM_GETV, id    ;Return value of a CW_FORM widget.
  473.  
  474. x = WIDGET_INFO(id, /CHILD)    ;Get head of list
  475. WIDGET_CONTROL, x, GET_UVALUE=u
  476. head = u.head
  477.  
  478. while head ne 0 do begin
  479.     WIDGET_CONTROL, head, GET_UVALUE=u, /NO_COPY
  480.     if n_elements(ret) le 0 then ret = CREATE_STRUCT(u.tag, u.value) $
  481.     else ret = CREATE_STRUCT(ret, u.tag, u.value)
  482.     next = u.next
  483.     WIDGET_CONTROL, head, SET_UVALUE=u, /NO_COPY
  484.     head = next
  485. endwhile
  486. return, ret
  487. end
  488.  
  489.  
  490. pro cw_form_modal_event, ev
  491. if ev.quit ne 0 then begin
  492.     child = WIDGET_INFO(ev.id, /CHILD)
  493.     WIDGET_CONTROL, child, GET_UVALUE=u  ;Get handle
  494.     WIDGET_CONTROL, ev.id, GET_VALUE=v  ;The widget's value
  495.     WIDGET_CONTROL, ev.top, /DESTROY
  496.     *u.handle = v
  497.     endif
  498. end
  499.  
  500. FUNCTION CW_FORM, parent, desc, $
  501.     COLUMN = column, IDS=ids, TITLE=title, UVALUE=uvalue
  502.  
  503. ;  ON_ERROR, 2                        ;return to caller
  504.   ; Set default values for the keywords
  505.   If KEYWORD_SET(column) then row = 0 else begin row = 1 & column = 0 & end
  506.  
  507.   p = parent
  508.   handle = 0L
  509.   if n_params() eq 1 then begin
  510.     desc = parent
  511.     if n_elements(title) le 0 then title='FORM Widget'
  512.         temp = WIDGET_BASE()
  513.     p = WIDGET_BASE(TITLE=title, Column = column, row=row, $
  514.                         GROUP_LEADER=temp, /MODAL)
  515.     handle = PTR_NEW(/ALLOCATE_HEAP)
  516.   endif
  517.   Base = WIDGET_BASE(p, Column = column, row=Row)
  518.  
  519.   if n_elements(uvalue) gt 0 then WIDGET_CONTROL, base, SET_UVALUE=uvalue
  520.   n = n_elements(desc)
  521.   ids = lonarr(n+2)        ;Element n is ^ to child, n+1 ^ to base
  522.   child = WIDGET_BASE(base)    ;Widget to contain info...
  523.   ids[n] = child
  524.   ids[n+1] = base
  525.   lasttag = 0
  526.   WIDGET_CONTROL, child, SET_UVALUE={ head: 0L, base: base, handle: handle}
  527.  
  528.   CW_FORM_BUILD, base, desc, 0, ids, lasttag
  529.   widget_control, base, EVENT_FUNC='CW_FORM_EVENT', $
  530.     FUNC_GET_VALUE='CW_FORM_GETV', PRO_SET_VALUE='CW_FORM_SETV'
  531.  
  532.   if n_params() eq 1 then begin        ;Modal?
  533.     WIDGET_CONTROL, p, /realize
  534.     XMANAGER, 'CW_FORM', p, EVENT_HANDLER='CW_FORM_MODAL_EVENT'
  535.         v = TEMPORARY(*handle)
  536.     PTR_FREE, handle
  537.         WIDGET_CONTROL, temp, /DESTROY
  538.     return, v
  539.     endif
  540.   return, base
  541. END
  542.